(setf *window-chain* nil)

(defun window-chain (function-list &optional next-function)
"Args: window-function-list
Presents a chain of windows, one at a time, each one appearing after the previous one closes. In addition to the usual methods. NEXT-FUNCTION specifies a function to be run after the last window function may be specified. Usually this would be a non-window function. If not specified, returns to top-level."
  (setf *window-chain* 
        (initial-display-window 475 300 :location '(3000 3000) 
                                :color 'post-it-yellow))
  (send *window-chain* :window-chain? t)
 ;(send *window-chain* :top-most (send *window-chain* :top-most? ))
  (send *window-chain* :top-most (send *vista* :always-on-top))
  (send *window-chain* :top-most? (send *vista* :always-on-top))
  (send *window-chain* :make-window-chain function-list next-function)
  *chain-window*)

(defun file-to-chain-window 
  (filename title window &optional (flush t) (add-help t) (fit t) (show t))
"args: filename title window &optional (flush t) (add-help t) (fit t) (show t)
gets text from filename and displays in *window-chain*. Same args as file-to-window"
  (send *window-chain* :start-buffering)
  (with-open-file
   (g filename)
   (send *vista* :update-help-window *window-chain* g title flush add-help nil))
  (send *window-chain* :set-window-parameters fit show)
  *window-chain* )

(defmeth display-window-proto2 :make-window-chain 
                  (function-list &optional (non-window-last-function nil))
  (send self :add-slot 'window-chain-functions function-list)
  (send self :add-slot 'window-number 0)
  (send self :make-window-chain-menu self)
  (send self :make-close-menu self)
  (send self :make-do-click self non-window-last-function)
  (send (send self :menu) :remove)
  (send self :next-message 0))


(defmeth display-window-proto2 :make-window-chain-menu (window)
  (let* ((menu (send self :menu))
         (items (send menu :items))
         (n (length (send window :slot-value 'window-chain-functions)))
         )
    
    (apply #'send menu :delete-items items)
    (apply #'send menu :append-items
           (send menu-item-proto :new "Next"
                 :action  #'(lambda () 
                              (let ((i (1+ (send window :slot-value 'window-number))))
                                (when (< i n) (send window :next-message i)))))
           (send menu-item-proto :new "Back"
                 :action  #'(lambda () 
                              (let ((i (1- (send window :slot-value 'window-number))))
                                (when (> i -1) (send window :next-message i)))))
           (send menu-item-proto :new "Close"
                 :action  #'(lambda () (send window :remove)))
           
           (send dash-item-proto :new)
           
           (send menu-item-proto :new "Help"
                 :action  #'(lambda () (send window :help-using-text n)))
           (send dash-item-proto :new)
           (select items (iseq (1- (length items)))))
    (send (first (last (send menu :items))) :title "Click For Next")
    ))

(defmeth display-window-proto2 :help-using-text (n)
  (let ((text (format nil "This is a \"text\" having ~d pages, one page per window. From the close box you can CLOSE the text; go to the NEXT page or go BACK a page, and you can get HELP.  You can also navigate, print, save, copy, etc. by clicking on the window itself:~%NEXT - left-click       MENU - right-click (print, save ...)~%BACK - ctrl-left-click  QUIT - ctrl-right-click~2%Click this window to close it~%" n)))
    (post-it text)))

(defmeth display-window-proto2 :make-close-menu (window)
  (defmeth window :close ()
    (let* ((menu (send window :menu))
           (items (send menu :items))
           (menu-item (send menu-item-proto :new "Menu"))
           (nitems (length items)))
      (apply #'send menu :delete-items items)
      (apply #'send menu :append-items (select items (list 2 5 0 1 3 4)))
      (send menu :popup   (- (first (send window :size)) 50) -20 window)
      (apply #'send menu :delete-items (send menu :items))
      (apply #'send menu :append-items items))))
  
(defmeth display-window-proto2 :make-do-click 
                  (window &optional (non-window-last-function nil used?))
  (defmeth window :do-click (x y m1 m2) ;m2 is right button
    (let* ((f-list (send self :slot-value 'window-chain-functions))
           (n (length f-list))
           (i (send self :slot-value 'window-number)))
      (cond
        ((and m1 m2) (send self :remove)(top-level))
        (m1 (setf i (1- i)) 
            (if (< i 0) (setf i 0))
            (send self :next-message i))
        (m2 (ignore-errors (send (send self :menu) :popup (- x 20) (- y 10) self)))
        ((not (send *vista* :click-to-close))
         (ignore-errors (send (send self :menu) :popup (- x 20) (- y 10)  self)))
        ((< i (1- n)) 
         (setf i (1+ i))
         (send self :next-message i))
        ((= i (1- n))
         (send self :remove)
         (cond 
           (used? (refresh-desktop) (progn (eval non-window-last-function)))
           (t (top-level nil))))))
    self))
  
(defmeth display-window-proto2 :next-message (i)
  (let* ((f-list (send self :slot-value 'window-chain-functions))
         (n (length f-list))
         (w ))
    (setf *linked-window* self)
    (send self :window-chain? t)
    (setf w (evalfunc (select f-list i)))
    (send self :title (strcat (send self :title) (format nil " (~d of ~d)" (1+ i) n)))
    (send self :slot-value 'window-number i)
    w))


(defun evalfunc (function)
  (eval function))

(setf *linked-window* nil)